perm filename BEAMF.FAI[NEW,LCS] blob
sn#149691 filedate 1975-03-10 generic text, type T, neo UTF8
00100 TITLE BEAMF
00200 ENTRY BEAMF
00300 EXTERNAL STF,MOD,.COMM.,AMOD
00400
00500
00700 RM←2↔ RX←3↔ RJ←4↔ RW←5↔ RH←6↔ RJA←7↔ RD←10↔ R9←11
00800 R8←12↔ RJX←13↔ RA←14↔ RJY←15
01500 BEAMF: 0 ;C NEXT IS FOR BEAMS
01600 MOVE RM,STF+=8 ;90 RMINI=RSTJ2
01700 MOVE RX,[=16.092] ; RX=2.7*RSTJ2*5.96
01750 FMPR RX,STF+=8
01900 ; R6=RHORZ(R6)
02000 ; R9=RHORZ(R9)
02100 ; IF(J10.LT.10)GO TO 91
02200 C NEXT FOR INNER, PARTIAL BEAMS
02300 ; R8=RHORZ(R8)
02400 ; R10=AMOD(R10,10.)
02500 ; GO TO(2,3,4),J10/10
02600 2; R8=R9+RX
02700 ; GO TO 4
02800 3; R8=R9-RX
02900 C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
03000 4; RH=R8
03100 C LEFT INNER POS.
03200 ; GO TO 1
03300 C******************************
03400 91; IF(J8.GE.0)GO TO 1
03500 92; R9=R3+RX
03600 ; IF(J8.LE.-20)R9=R6-RX
03700 192; J8=-J8
03800 ; IF(J10.EQ.0)J10=MOD(J8,10)
03900 ; J8=J8-J10
04000 ; IF(J10.EQ.0)J10=1
04100 ; R10=J10
04200 C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
04300 1; IF(IABS(J4).LT.100)GO TO 97
04400 ; RMINI=.6*RSTJ2
04500 ; R5=AMOD(R5,100.0)
04600 C SPACE BETWEEN BEAMS
04700 97; RJ=RMINI*11.
04800 ; RW=RMINI*RHGT
04900 C DIST. UP OR DOWN FROM NOTE HEAD.
05000 ; RJA=R10*RJ
05100 C DISPLACEMENT
05300 ; RD=R9
05400 C POSITION 3
05500 ; RJX=CENTR-RW+RJA
05600 C FINAL HEIGHT
05800 ; IF(J7)J7=-J7
05900 C NEG R7=TREMOLO
06000 ; RX=MOD(J7,10)
06100 ; JJ2=J7-20
06200 ; RA=R6
06300 C HORIZANTAL DIST.
06400 ; RJY=R5*RST7+POS-RST18-RW+RJA
06500 C************************
06600 ; RW=R14*RMINI
06700 ; RY=1.
06800 ; IF(J7.GE.20)GO TO 930
06900 C JUMP IF STEMS ARE DOWN
07000 ; RY=-RY
07100 C FOR THICKENING INCR.
07200 ; JJ2=J7-10
07300 ; RJ=-RJ
07800 ; RJA=RMINI*R2HGT-2.*RJA
07900 ; RJX=RJX+RJA
08000 ; RJY=RJY+RJA
08100 ; R3Q=R3Q+RW
08200 C POSITION 1
08300 ; RA=RA+RW
08400 C POSITION 2
08500 ; RD=RD+RW
08600 C******************************
08700 ; RH=RH+RW
08800 930; IF(R7.GE.0)GO TO 98
08900 ; R3Q=R3Q-13.*RSTJ2
09000 C SHIFTS HEAD OF TREM. TO LEFT.
09100 ; RA=R3Q+27.*RSTJ2
09200 98; RSTJ2=RSTJ2*RBM
09300 C RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
09400 93; IF(JJ2.GT.RX)GO TO 94
09500 ; IF(J10.GE.10)GO TO 7
09600 C**********************
09700 ; IF(J8.EQ.0)GO TO 94
09800 ; R3=RW
09900 C******************************
10100 ; IF(J9.EQ.0)GO TO 292
10200 ; IF(J8.GE.20)GO TO 193
10300 C******************************
10500 293; RX=R3Q-RD
10600 ; GO TO 194
10700 C******************************
10800 7; RHX=RH-R3Q
11000 ; R3=RD-R3Q
11100 ; GO TO 292
11200 193; RX=RD-RA
11300 194; R3=ABS(RX)
11400 292; DISX=ABS(R3Q-RA)
11500 ; HGT=RJX-RJY
11600 ; IF(J10.GE.10)HGT1=HGT*RHX/DISX
11700 C**********************
11800 ; R3=R3/DISX
11900 195; HGT=HGT*R3
12000 196; L=J8/10
12100 ; J8=0
12200 ; IF(J10.GE.10)GO TO 8
12300 C***************
12400 ; IF(L.EQ.1)GO TO 95
12500 C BEAM LFT=1, RT=2 (PARAM 8=10 OR 20)
12600 ; R3Q=RD
12700 ; RJX=RJY+HGT
12800 ; GO TO 94
12900 C**************
13000 8; R3Q=RH
13100 ; RA=RD
13200 ; RJY=RJX-HGT
13300 ; RJX=RJX-HGT1
13400 ; GO TO 94
13500 95; RA=RD
13600 ; RJY=RJX-HGT
13700 94; RC=0
13800 CXX; L=8
14000 CXX; IF(RMINI.LT.1.)L=7.*RMINI
14100 ; L=8.*RMINI
14200 C MINI LINES HAVE .2 SMALLER BEAMS. MAYBE CHANGE THIS??
14300 ; CALL LINES(R3Q,RJX,3)
14400 ; DO 941 K=1,L
14500 ; CALL BMS
14600 ; IF(PLT.GE.0)GO TO 940
14800 ; RC=RC+RY
14900 C FOR THICKENING.
15000 ; CALL BMS
15100 ; CALL EXCH(RA,R3Q)
15200 941; CALL EXCH(RJY,RJX)
15300 ; CALL BMS
15400 C DRAWS 5 LINES FOR BEAMS.
15500 940; JJ2=JJ2-1
15600 ; IF(JJ2.LE.0)RETURN
15700 C IF P7=10 OR 20 ONE BEAM WILL APPEAR.
15800 ; RJY=RJY+RJ
15900 ; RJX=RJX+RJ
16000 ; GO TO 93